Warning: package 'ggplot2' was built under R version 4.4.3
── Attaching core tidyverse packages ──────────────────────── tidyverse 2.0.0 ──
✔ dplyr 1.1.4 ✔ readr 2.1.5
✔ forcats 1.0.0 ✔ stringr 1.5.1
✔ ggplot2 4.0.0 ✔ tibble 3.2.1
✔ lubridate 1.9.3 ✔ tidyr 1.3.1
✔ purrr 1.0.2
── Conflicts ────────────────────────────────────────── tidyverse_conflicts() ──
✖ dplyr::filter() masks stats::filter()
✖ dplyr::lag() masks stats::lag()
ℹ Use the conflicted package (<http://conflicted.r-lib.org/>) to force all conflicts to become errors
library(plotly)
Warning: package 'plotly' was built under R version 4.4.3
Attaching package: 'plotly'
The following object is masked from 'package:ggplot2':
last_plot
The following object is masked from 'package:stats':
filter
The following object is masked from 'package:graphics':
layout
setValidity("waldCI", function(object) { msgs <-character()if (length(object@lb) !=1) { msgs <-c(msgs, "lb must be a numeric of length 1.") }if (length(object@ub) !=1) { msgs <-c(msgs, "ub must be a numeric of length 1.") }if (length(object@level) !=1) { msgs <-c(msgs, "level must be a numeric of length 1.") }if (is.na(object@lb) ||is.na(object@ub) ||is.na(object@level)) { msgs <-c(msgs, "lb, ub, and level must not be NA.") }if (!is.finite(object@lb) ||!is.finite(object@ub)) { msgs <-c(msgs, "lb and ub must be finite.") }if (object@level <=0|| object@level >=1) { msgs <-c(msgs, "level must be strictly between 0 and 1.") }if (object@lb >= object@ub) { msgs <-c(msgs, "lb must be strictly less than ub.") }if (length(msgs) ==0) {TRUE } else msgs})
setReplaceMethod("mean", "waldCI", function(x, value) { se <-sterr(x) z <-qnorm((1+ x@level) /2) half_width <- z * se x@lb <- value - half_width x@ub <- value + half_widthvalidObject(x) x})setGeneric("sterr<-", function(x, value) standardGeneric("sterr<-"))
[1] "sterr<-"
setReplaceMethod("sterr", "waldCI", function(x, value) {if (value <=0) stop("sterr must be positive.") m <-mean(x) z <-qnorm((1+ x@level) /2) half_width <- z * value x@lb <- m - half_width x@ub <- m + half_widthvalidObject(x) x})
setMethod("transformCI", signature(ci ="waldCI", f ="function"),function(ci, f) {# crude monotonicity check on [lb, mid, ub] xs <-c(lb(ci), mean(ci), ub(ci)) ys <-sapply(xs, f) inc <-all(diff(ys) >=0) dec <-all(diff(ys) <=0)if (!(inc || dec)) {warning("transformCI: function does not appear monotonic on this interval; results may be meaningless.") }# transform endpoints and reorder if needed a <-f(lb(ci)) b <-f(ub(ci)) new_bounds <-sort(c(a, b))makeWaldCI(level =level(ci),lb = new_bounds[1],ub = new_bounds[2] ) })
p_a <- usa_spikes %>%plot_ly(x =~date,y =~cases_avg_per_100k,type ="scatter",mode ="lines",line =list(color ="rgba(100,100,100,0.8)"),name ="7-day average" ) %>%# add points only where spike_type is not NAadd_markers(data =subset(usa_spikes, !is.na(spike_type)),x =~date,y =~cases_avg_per_100k,color =~spike_type,colors =c("firebrick", "goldenrod"),marker =list(size =6, opacity =0.8),name =~spike_type ) %>%layout(title =list(text =paste0("U.S. COVID-19: Major and Minor Spikes (7-day average per 100k)","<br><sub>Major ≥ ", round(major_cutoff, 1)," per 100k | Minor ≥ ", round(minor_cutoff, 1), "</sub>" ) ),xaxis =list(title =""),yaxis =list(title ="New cases per 100k (7-day avg)"),legend =list(orientation ="h", x =0, y =1.1),margin =list(t =70),annotations =list(x =1, y =-0.15, xref ="paper", yref ="paper",text ="Source: NYTimes COVID-19 Rolling Averages",showarrow =FALSE, xanchor ="right", yanchor ="auto" ) )p_a
A line object has been specified, but lines is not in the mode
Adding lines to the mode...
A line object has been specified, but lines is not in the mode
Adding lines to the mode...